home *** CD-ROM | disk | FTP | other *** search
/ PC-Blue - MS DOS Public Domain Library / PC-Blue MS-DOS Public Domain Library - NYACC.iso / vol203 / mailmerg.inc < prev    next >
Encoding:
Text File  |  1986-11-30  |  14.0 KB  |  407 lines
  1. { File = MAILMERG.INC -- Include file for Reliance Mailing List
  2.     Copyright (c) 1986 William Meacham, All Rights Reserved
  3.     Revised: 3/9/86 }
  4.  
  5. overlay procedure make_mailmerge_file  ;
  6.  
  7. label  99 ;  { to exit prematurely }
  8.  
  9. var
  10.     which_ones  : prt_criterion ;
  11.     how_to_sort : sort_criterion ;
  12.     stop        : boolean ;        { whether to stop before done }
  13.     prt_num     : num_str_typ ;    { for printing dollar amounts }
  14.     prt_date    : datestring ;
  15.     prt_zip     : string[10] ;
  16.     field       : array [1..15] of boolean ; { which field to include in output }
  17.     out_file    : text ;
  18.     out_fname   : str14 ;
  19.     num_out,
  20.     num_bad     : integer ;
  21.     overwrite   : boolean ;
  22.     i           : integer ;
  23.  
  24. { ==================== }
  25.  
  26. procedure get_a_rec ;
  27.   { get the next record to print }
  28.   begin
  29.     if how_to_sort = name then
  30.       begin
  31.         nextkey (ix1_file,rec_num,key1) ;
  32.         if OK then
  33.             getrec (mf_file,rec_num,master)
  34.       end
  35.     else { how_to_sort := szip }
  36.       begin
  37.         nextkey (ix2_file,rec_num,key2) ;
  38.         if OK then
  39.             getrec (mf_file,rec_num,master)
  40.       end
  41.   end ; { proc get_a_rec }
  42.  
  43. { ==================== }
  44.  
  45. procedure pick_fields ;
  46.   const
  47.     file_msg = 'OUTPUT FILE ALREADY EXISTS -- DO YOU WISH TO WRITE OVER IT? (Y/N)' ;
  48.   var
  49.     i           : integer ;
  50.     some_chosen : boolean ;
  51.  
  52. { ~~~~~~~~~~~~~~~~~~~~ }
  53.  
  54.   procedure check_file ;
  55.     label 50 ;
  56.     var
  57.       bad,
  58.       overwrite : boolean ;
  59.       i,                       { loop counter }
  60.       l,                       { length }
  61.       c,                       { position of colon }
  62.       p         : integer ;    { position of period }
  63.     begin
  64.       bad := false ;
  65.       if out_fname = '' then                   { no entry }
  66.           begin bad := true ; goto 50 end ;
  67.  
  68.       l := length(out_fname) ;
  69.       c := pos(':',out_fname) ;
  70.       p := pos('.',out_fname) ;
  71.       if (c <> 0) and (c <> 2) then            { colon not in right place }
  72.           begin bad := true ; goto 50 end ;
  73.       if (c = 2) and not (out_fname[1] in ['A'..'P']) then
  74.           begin bad := true ; goto 50 end ;    { drive designation no good }
  75.       if p <> 0 then
  76.         begin
  77.           if (p - c) > 9 then                  { more than 8 chars in name }
  78.               begin bad := true ; goto 50 end ;
  79.           for i := c+1 to p-1 do               { bad char in name }
  80.               if not(out_fname[i] in ['A'..'Z','0'..'9']) then
  81.                   begin bad := true ; goto 50 end ;
  82.           if (l - p) > 3 then                  { more than 3 chars in ext }
  83.               begin bad := true ; goto 50 end ;
  84.           for i := p+1 to l do                 { bad char in ext }
  85.               if not(out_fname[i] in ['A'..'Z','0'..'9']) then
  86.                   begin bad := true ; goto 50 end ;
  87.         end
  88.       else  { p = 0 }
  89.         begin
  90.           if (l - c) > 8 then                  { more than 8 chars in name }
  91.               begin bad := true ; goto 50 end ;
  92.           for i := c+1 to l do                 { bad char in name }
  93.               if not(out_fname[i] in ['A'..'Z','0'..'9']) then
  94.                   begin bad := true ; goto 50 end ;
  95.         end ;
  96. 50:
  97.       if bad then
  98.         begin
  99.           show_msg ('INVALID FILENAME') ;
  100.           fld := 16
  101.         end
  102.       else if exists (out_fname) then
  103.         begin
  104.           write_str (file_msg,1,21) ;
  105.           beep ;
  106.           read_yn (overwrite,67,21) ;
  107.           if overwrite then
  108.               fld := 17
  109.           else
  110.               fld := 16 ;
  111.           clrline(1,21)
  112.         end
  113.     end ; { proc check_file }
  114.  
  115. { ~~~~~~~~~~~~~~~~~~~~ }
  116.  
  117.   begin
  118.     clrscr ;
  119.     write_str ('CHOOSE FIELDS FOR MAILMERGE FILE',24,1) ;
  120.     paint_screen(1) ;
  121.     write_str ('Output file:',1,18) ;
  122.     write_str ('(Note -- you must make sure there is enough space for the file!)',1,19) ;
  123.     for i := 1 to 15 do
  124.         field[i] := false ;
  125.     out_fname := '' ;
  126.     write_bool(field[1],14,3) ;    { frst_name }
  127.     write_bool(field[2],14,4) ;    { last_name }
  128.     write_bool(field[3],14,6) ;    { title }
  129.     write_bool(field[4],14,7) ;    { salutation }
  130.     write_bool(field[5],14,9) ;    { addr1 }
  131.     write_bool(field[6],14,10) ;   { addr2 }
  132.     write_bool(field[7],14,11) ;   { city }
  133.     write_bool(field[8],14,12) ;   { state }
  134.     write_bool(field[9],28,12) ;   { zip }
  135.     write_bool(field[10],14,14) ;  { home_phon }
  136.     write_bool(field[11],14,15) ;  { work_phon }
  137.     write_bool(field[12],41,14) ;  { precinct }
  138.     write_bool(field[13],65,4) ;   { last_amt }
  139.     write_bool(field[14],65,5) ;   { last_date }
  140.     write_bool(field[15],65,6) ;   { tot_amt }
  141.     fld := 1 ;
  142.     repeat
  143.         case fld of
  144.           1  : read_bool(field[1],14,3) ;    { frst_name }
  145.           2  : read_bool(field[2],14,4) ;    { last_name }
  146.           3  : read_bool(field[3],14,6) ;    { title }
  147.           4  : read_bool(field[4],14,7) ;    { salutation }
  148.           5  : read_bool(field[5],14,9) ;    { addr1 }
  149.           6  : read_bool(field[6],14,10) ;   { addr2 }
  150.           7  : read_bool(field[7],14,11) ;   { city }
  151.           8  : read_bool(field[8],14,12) ;   { state }
  152.           9  : read_bool(field[9],28,12) ;   { zip }
  153.           10 : read_bool(field[10],14,14) ;  { home_phon }
  154.           11 : read_bool(field[11],14,15) ;  { work_phon }
  155.           12 : read_bool(field[12],41,14) ;  { precinct }
  156.           13 : read_bool(field[13],65,4) ;   { last_amt }
  157.           14 : read_bool(field[14],65,5) ;   { last_date }
  158.           15 : read_bool(field[15],65,6) ;   { tot_amt }
  159.           16 : begin                         { output file name }
  160.                  read_str (out_fname,14,14,18) ;
  161.                  out_fname := purgech (out_fname,' ') ;
  162.                  for i := 1 to length (out_fname) do
  163.                      out_fname[i] := upcase(out_fname[i]) ;
  164.                  write_str (out_fname,14,18) ;
  165.                  for i := length(out_fname) + 1 to 14 do
  166.                      write(' ') ;
  167.                  if (fld > 16) and (fld < maxint) then
  168.                      check_file
  169.                end ; { 16 }
  170.           17 : pause
  171.         end ; { case }
  172.  
  173.         if fld < 1 then
  174.             fld := 1
  175.         else if (fld > 99) and (fld < maxint) then          { page forward }
  176.           begin
  177.             check_file ;                                  { do edit checks }
  178.             if fld > 17 then                   { if OK, stick on the Pause }
  179.                 fld := 17
  180.           end ;
  181.  
  182.     until fld > 17 ;
  183.  
  184.     some_chosen := false ;
  185.     for i := 1 to 15 do
  186.         some_chosen := some_chosen or field[i] ;
  187.     if not some_chosen then
  188.         fld := maxint ;
  189.   end ; { proc pick_fields }
  190.  
  191. { ==================== }
  192.  
  193. procedure write_a_record ;
  194.   label  99 ;
  195.   var
  196.     st : string[255] ;
  197.     i  : integer ;
  198.     ch : char ;
  199.   begin
  200.     if keypressed then
  201.       begin
  202.         keyin (ch) ;
  203.         if ch = #$1B then
  204.           begin
  205.             write_str ('STOP NOW? (Y/N)',9,7) ;
  206.             beep ;
  207.             read_yn (stop,25,7) ;
  208.             OK := not stop ;
  209.             if OK then clrline(9,7) ;
  210.           end
  211.       end ;
  212.     if OK then
  213.       begin
  214.         st := '' ;
  215.         with master do
  216.           begin
  217.             if field[1] then
  218.                 if pos(',',frst_name) <> 0 then
  219.                     st := concat(st,'"',frst_name,'"',',')
  220.                 else
  221.                     st := concat(st,frst_name,',') ;
  222.             if field[2] then
  223.                 if pos(',',last_name) <> 0 then
  224.                     st := concat(st,'"',last_name,'"',',')
  225.                 else
  226.                     st := concat(st,last_name,',') ;
  227.             if field[3] then
  228.                 if pos(',',title) <> 0 then
  229.                     st := concat(st,'"',title,'"',',')
  230.                 else
  231.                     st := concat(st,title,',') ;
  232.             if field[4] then
  233.                 if pos(',',salutation) <> 0 then
  234.                     st := concat(st,'"',salutation,'"',',')
  235.                 else
  236.                     st := concat(st,salutation,',') ;
  237.             if field[5] then
  238.                 if pos(',',addr1) <> 0 then
  239.                     st := concat(st,'"',addr1,'"',',')
  240.                 else
  241.                     st := concat(st,addr1,',') ;
  242.             if field[6] then
  243.                 if pos(',',addr2) <> 0 then
  244.                     st := concat(st,'"',addr2,'"',',')
  245.                 else
  246.                     st := concat(st,addr2,',') ;
  247.             if field[7] then
  248.                 if pos(',',city) <> 0 then
  249.                     st := concat(st,'"',city,'"',',')
  250.                 else
  251.                     st := concat(st,city,',') ;
  252.             if field[8] then
  253.                 if pos(',',state) <> 0 then
  254.                     st := concat(st,'"',state,'"',',')
  255.                 else
  256.                     st := concat(st,state,',') ;
  257.             if field[9] then
  258.               begin
  259.                 prt_zip := zip ;
  260.                 if length(prt_zip) > 5 then
  261.                     insert('-',prt_zip,6) ;
  262.                 if pos(',',prt_zip) <> 0 then
  263.                     st := concat(st,'"',prt_zip,'"',',')
  264.                 else
  265.                     st := concat(st,prt_zip,',')
  266.               end ;
  267.             if field[10] then
  268.                 if pos(',',home_phon) <> 0 then
  269.                     st := concat(st,'"',home_phon,'"',',')
  270.                 else
  271.                     st := concat(st,home_phon,',') ;
  272.             if field[11] then
  273.                 if pos(',',work_phon) <> 0 then
  274.                     st := concat(st,'"',work_phon,'"',',')
  275.                 else
  276.                     st := concat(st,work_phon,',') ;
  277.             if field[12] then
  278.                 if pos(',',precinct) <> 0 then
  279.                     st := concat(st,'"',precinct,'"',',')
  280.                 else
  281.                     st := concat(st,precinct,',') ;
  282.             if field[13] then
  283.               begin
  284.                 editnum(last_amt,wid,frac,prt_num) ;
  285.                 prt_num := stripch(prt_num,' ') ;
  286.                 if pos(',',prt_num) <> 0 then
  287.                     st := concat(st,'"',prt_num,'"',',')
  288.                 else
  289.                     st := concat(st,prt_num,',') ;
  290.                 if length(st) > 240 then goto 99
  291.               end ;
  292.             if field[14] then
  293.               begin
  294.                 prt_date := mk_dt_st(last_date) ;
  295.                 prt_date := purgech(prt_date,' ') ;
  296.                 st := concat(st,prt_date,',') ;
  297.                 if length(st) > 240 then goto 99
  298.               end ;
  299.             if field[15] then
  300.               begin
  301.                 editnum(tot_amt,wid,frac,prt_num) ;
  302.                 prt_num := stripch(prt_num,' ') ;
  303.                 if pos(',',prt_num) <> 0 then
  304.                   begin
  305.                     if length(st) + length(prt_num) + 3 < 256 then
  306.                         st := concat(st,'"',prt_num,'"',',')
  307.                     else
  308.                         st[0] := #242  { make it too long }
  309.                   end
  310.                 else   { no comma }
  311.                   begin
  312.                     if length(st) + length(prt_num) + 1 < 256 then
  313.                         st := concat(st,prt_num,',')
  314.                     else
  315.                         st[0] := #242  { make it too long }
  316.                   end  { else, no comma }
  317.               end { if field[15] }
  318.           end ; { with }
  319.         delete(st,length(st),1) ; { delete trailing comma }
  320. 99:
  321.         if length(st) > 240 then
  322.             num_bad := succ(num_bad)
  323.         else
  324.           begin
  325.             writeln (out_file,st) ;
  326.             num_out := succ(num_out)
  327.           end
  328.       end  { if OK }
  329.   end ; { procedure write_a_record }
  330.  
  331. { ==================== }
  332.  
  333. procedure create_file ;
  334.   begin
  335.     clrscr ;
  336.     write_str ('Creating ',9,3) ;
  337.     write (out_fname,' . . .') ;
  338.     write_str ('Press ESC to stop ',9,5) ;
  339.     num_out := 0 ;
  340.     num_bad := 0 ;
  341.     assign(out_file,out_fname) ;
  342.     rewrite(out_file) ;
  343.     open_database ;
  344.     if how_to_sort = name then
  345.         clearkey (ix1_file)
  346.     else  { how_to_sort = szip }
  347.         clearkey (ix2_file) ;
  348.     repeat
  349.         get_a_rec ;
  350.         if OK then
  351.             case which_ones of
  352.               all  : write_a_record ;
  353.               pcat : if (master.flags and mask) > 0 then
  354.                         write_a_record ;
  355.               pct  : if master.precinct = pcinct then
  356.                         write_a_record ;
  357.               pzip : if copy(master.zip,1,5) = copy(zipcode,1,5) then
  358.                         write_a_record ;
  359.               dt   : if not (greater_date(lastdt,master.last_date) = 1) then
  360.                         write_a_record ;
  361.               amt  : if not (greater(contrib,master.tot_amt)) then
  362.                         write_a_record ;
  363.             end { case }
  364.     until not OK ;
  365.     close_database ;
  366.     close(out_file) ;
  367.     gotoxy(9,9) ;
  368.     write(num_out,' records written') ;
  369.     if num_bad > 0 then
  370.         write ('.   ',num_bad,' not written -- too long.') ;
  371.     beep ;
  372.     hard_pause ;
  373.     if num_out = 0 then
  374.         erase(out_file) ;
  375.     fld := 1 ;
  376.   end ; { proc create_file }
  377.  
  378. { ==================== }
  379.  
  380. begin { ---- procedure make_mailmerge_file ---- }
  381.     select (which_ones, how_to_sort, mailmerge) ;
  382.     if not (fld = maxint) then
  383.         pick_fields ;
  384.     if not (fld = maxint) then
  385.         create_file ;
  386.     fld := 1
  387. end ; { proc make_mailmerge_file }
  388.  
  389. { ---- EOF FILE MAILMERG.INC -------------------------------- }
  390. = copy(zipcode,1,5) then
  391.                         write_a_record ;
  392.               dt   : if not (greater_date(lastdt,master.last_date) = 1) then
  393.                         write_a_record ;
  394.               amt  : if not (greater(contrib,master.tot_amt)) then
  395.                         write_a_record ;
  396.             end { case }
  397.     until not OK ;
  398.     close_database ;
  399.     close(out_file) ;
  400.     gotoxy(9,9) ;
  401.     write(num_out,' records written') ;
  402.     if num_bad > 0 then
  403.         write ('.   ',num_bad,' not written -- too long.') ;
  404.     beep ;
  405.     hard_pause ;
  406.     if num_out = 0 then
  407.